﻿Public MustInherit Class Puzzle

    'MustOverride ReadOnly Property Name() As String
    MustOverride Function Save() As String
    MustOverride Sub Load(ByVal Data As String)
    MustOverride Sub Solve()

    Event LogAdd(ByVal Text As String)

    Dim ccc As Size
    Dim Offset As Point
    Dim WithEvents Timer As New Timer

    Protected Cells As Cells
    Protected Groups As Groups
    Protected Selection As New SelectedCells
    Public Regions As List(Of Region)

    Protected Undos As New List(Of String)
    Protected Redos As New List(Of String)

    Public HintArea As New Rectangle
    Public Size As Integer = 10
    Public Scale As Double = 1
    Public AvailableSizes As New List(Of Integer)
    Public HintStyle As Integer = 1

    Public Title As String
    Public Mode As PuzzleMode
    Public WithEvents Board As Board

    Protected m_Cursor As New Point
    Property Cursor As Point
        Get
            Return m_Cursor
        End Get
        Set(ByVal Value As Point)
            Invalidate(CellRect(Cursor.X, Cursor.Y, 1, 1))
            m_Cursor = Value
            CursorOn = True
            Timer.Enabled = False
            Timer.Enabled = True
            Invalidate(CellRect(Cursor.X, Cursor.Y, 1, 1))
        End Set
    End Property

#Region " Load & Save "

    Sub SavePuzzle(ByVal Doc As Xml.XmlTextWriter)
        Doc.WriteElementString("Name", TypeName(Me))
        Doc.WriteElementString("Size", Size)
        Doc.WriteStartElement("Cells")
        For Each Cell In Cells
            Cell.Save(Doc)
        Next
        Doc.WriteEndElement()
        Doc.WriteStartElement("Regions")
        For Each Region In Regions
            Region.Save(Doc)
        Next
        Doc.WriteEndElement()
    End Sub

    Sub LoadPuzzle(ByVal Doc As Xml.XmlNode)
        Size = Doc.SelectSingleNode("Size").InnerText
        NewPuzzle()
        If Not Doc.SelectSingleNode("Cells") Is Nothing Then
            For Each Node As Xml.XmlNode In Doc.SelectSingleNode("Cells").ChildNodes
                Dim Cell = Find(Node.SelectSingleNode("x").InnerText, Node.SelectSingleNode("y").InnerText)
                Cell.g = Node.SelectSingleNode("g").InnerText
            Next
        End If
        If Not Doc.SelectSingleNode("Regions") Is Nothing Then
            For Each Node As Xml.XmlNode In Doc.SelectSingleNode("Regions").ChildNodes
                Dim Region As New Region
                Regions.Add(Region)
                Region.Hint = Node.SelectSingleNode("hint").InnerText
                For Each CellNode In Node.SelectSingleNode("Cells").ChildNodes
                    Dim Cell = Find(CellNode.SelectSingleNode("x").InnerText, CellNode.SelectSingleNode("y").InnerText)
                    Region.Cells.Add(Cell)
                Next
            Next
        End If
        Invalidate()
    End Sub

#End Region

    Overridable Sub NewPuzzle()
        Cells = New Cells(From y In Range(1, Size) From x In Range(1, Size) Let Cell = New Cell(Me, x, y) Select Cell)
        Groups = New Groups(From t In Range(1, 2) From i In Range(1, Size) Let Group = New Group(t, i, Cells.Where(Function(c) c.Index(t) = i)) Select Group)
        SetNeighbours()
        Cursor = New Point(1, 1)
        Invalidate()
        Regions = New List(Of PuzzleStudio.Region)
        UndoStack.Clear()
        RedoStack.Clear()
        ArrangeButtons()
    End Sub

    Overridable Sub NewCell(ByVal Cell As Cell)

    End Sub

    Private Sub SetNeighbours()
        For Each Cell In Cells
            Dim c1 As Cell = Cell
            Cell.Neighbours = New Cells(Cells.Where(Function(c) Not c Is c1 And Math.Abs(c.x - c1.x) <= 1 And Math.Abs(c.y - c1.y) <= 1))
            Cell.Sides = New Cells(Cells.Where(Function(c) Not c Is c1 And Math.Abs(c.x - c1.x) + Math.Abs(c.y - c1.y) = 1))
        Next
    End Sub

    Overridable Sub Edit(ByVal Cmd As String)
        Select Case Cmd
            Case "expand"
                If AvailableSizes.Count = 0 Then Exit Select
                Dim a = (From s In AvailableSizes Where s > Size Order By s).FirstOrDefault
                If a = 0 Then Exit Sub
                Size = a
                NewPuzzle()
            Case "shrink"
                If AvailableSizes.Count = 0 Then Exit Select
                Dim a = (From s In AvailableSizes Where s < Size Order By s Descending).FirstOrDefault
                If a = 0 Then Exit Sub
                Size = a
                NewPuzzle()
            Case "clear highlights"
                Selection.Clear()
                Invalidate()
            Case "mark"
                '                If Not HighlightMode Then Exit Sub
                Dim Cell = Find(Cursor.X, Cursor.Y)
                If Cell Is Nothing Then Exit Sub
                Selection.Invert(Cell)
                Invalidate(CellRect(Cell.x, Cell.y))
            Case "make group"
                For Each res In (From r In Regions From c In r.Cells.Intersect(Selection)).ToList
                    res.r.Cells.Remove(res.c)
                    If res.r.Cells.Count = 0 Then Regions.Remove(res.r)
                Next
                Dim Region As New Region
                Regions.Add(Region)
                For Each c In Selection
                    Region.Cells.Add(c)
                Next
                Selection.Clear()
                Highlighting = False
                Invalidate()
            Case "rotate left"
                Dim M(Size, Size)
                For Each Cell In From c In Cells
                    M(Cell.x, Cell.y) = Cell.g
                Next
                For Each Cell In From c In Cells
                    Cell.g = M(Size - Cell.y + 1, Cell.x)
                Next
                Invalidate()
            Case "rotate right"
                Dim M(Size, Size)
                For Each Cell In From c In Cells
                    M(Cell.x, Cell.y) = Cell.g
                Next
                For Each Cell In From c In Cells
                    Cell.g = M(Cell.y, Size - Cell.x + 1)
                Next
                Invalidate()
        End Select
    End Sub

    Sub SetHintsFromMatrix(ByVal M)
        For Each Cell In From c In Cells
            Cell.g = M(Cell.x, Cell.y)
        Next
    End Sub

    Overridable Function OnKeyPress(ByVal Key As String) As Boolean
        Select Case Key
            Case "left"
                If Cursor.X > 1 - HintArea.Left Then Cursor = New Point(Cursor.X - 1, Cursor.Y)
                Return True
            Case "right"
                If Cursor.X < Size + HintArea.Width Then Cursor = New Point(Cursor.X + 1, Cursor.Y)
                Return True
            Case "up"
                If Cursor.Y > 1 - HintArea.Top Then Cursor = New Point(Cursor.X, Cursor.Y - 1)
                Return True
            Case "down"
                If Cursor.Y < Size + HintArea.Height Then Cursor = New Point(Cursor.X, Cursor.Y + 1)
                Return True
            Case "^left"
                Cursor = New Point(1 - HintArea.Left, Cursor.Y)
                Return True
            Case "^right"
                Cursor = New Point(Size + HintArea.Width, Cursor.Y)
                Return True
            Case "^up"
                Cursor = New Point(Cursor.X, 1 - HintArea.Top)
                Return True
            Case "^down"
                Cursor = New Point(Cursor.X, Size + HintArea.Height)
                Return True
            Case "home"
                Cursor = New Point(1 - HintArea.Left, 1 - HintArea.Top)
                Return True
            Case "end"
                Cursor = New Point(Size + HintArea.Width + HintArea.Width, Size + HintArea.Height)
                Return True
            Case "delete"
                If Not CursorCell Is Nothing Then CursorCell.g = ""
            Case " "
                Edit("mark")
                Return True
        End Select
    End Function

    ReadOnly Property CursorCell As Cell
        Get
            Return Find(Cursor.X, Cursor.Y)
        End Get
    End Property

    Protected AutosolveMode As Boolean
    Sub SetAutosolve(ByVal Value As Boolean)
        AutosolveMode = Value
    End Sub

    ReadOnly Property SupportsSizing As Boolean
        Get
            Return AvailableSizes.Count > 1
        End Get
    End Property

    Public SupportsRegioning As Boolean

    Sub Normalize(ByRef R As Rectangle, ByVal x As Integer, ByVal y As Integer)
        Dim h As Integer = R.Height \ y
        Dim w As Integer = R.Width \ x
        If h > w Then h = w Else w = h
        ccc = New Size(w, h)
        Offset = New Point(R.Left + (R.Width - ccc.Width * x) / 2, R.Top + (R.Height - ccc.Height * y) / 2)
        HintFont(1) = New Font("calibri", ccc.Height / 2, FontStyle.Regular, GraphicsUnit.Point)
        HintFont(2) = New Font("calibri", ccc.Height / 5, FontStyle.Regular, GraphicsUnit.Point)
        PencilmarkFont = New Font("segoe print", ccc.Height / 5, FontStyle.Bold, GraphicsUnit.Point)
        FoundFont = New Font("segoe print", CellRect(1, 1).Height / 2, FontStyle.Regular, GraphicsUnit.Point)
        'Fonts(3) = New Font("segoe ui", CellRect(1, 1).Height / 5, FontStyle.Regular, GraphicsUnit.Point)
    End Sub

    Public HintFont(2), PencilmarkFont, FoundFont As Font

    Sub New()
        Timer.Interval = 300
    End Sub

    ReadOnly Property CellRect(ByVal x As Integer, ByVal y As Integer) As Rectangle
        Get
            x += HintArea.Left
            y += HintArea.Top
            Dim R As New Rectangle(Offset.X + x * ccc.Width, Offset.Y + y * ccc.Height, ccc.Width, ccc.Height)
            Dim Scale = If(Find(x, y) Is Nothing, 1, Find(x, y).Scale)
            If Scale <> 1 Then R.Inflate(-R.Width * (1 - Scale) / 2, -R.Height * (1 - Scale) / 2)
            Return R
        End Get
    End Property

    ReadOnly Property CellRect(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer, ByVal h As Integer) As Rectangle
        Get
            x += HintArea.Left
            y += HintArea.Top
            Dim R As New Rectangle(Offset.X + x * ccc.Width, Offset.Y + y * ccc.Height, w * ccc.Width, h * ccc.Height)
            Dim Scale = If(Find(x, y) Is Nothing, 1, Find(x, y).Scale)
            If Scale <> 1 Then R.Inflate(-R.Width * (1 - Scale) / 2, -R.Height * (1 - Scale) / 2)
            Return R
        End Get
    End Property

    Overridable Sub ShowCursor(ByVal G As Graphics)
        If Not CursorOn Then Exit Sub
        Dim R As Rectangle = CellRect(Cursor.X, Cursor.Y)
        R.Inflate(-3, -3)
        If Highlighting Then
            G.FillRectangle(New SolidBrush(Color.FromArgb(128, SystemColors.Highlight)), R)
        Else
            G.DrawRectangle(New Pen(SystemColors.Highlight, 2), R)
        End If
    End Sub

    Sub Invalidate()
        If Board Is Nothing Then Exit Sub
        Board.Invalidate()
    End Sub

    Sub Invalidate(ByVal Rect As Rectangle)
        If Board Is Nothing Then Exit Sub
        Board.Invalidate(Rect)
    End Sub

    Dim CursorOn As Boolean
    Private Sub Timer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer.Tick
        CursorOn = Not CursorOn
        Invalidate(CellRect(Cursor.X, Cursor.Y))
    End Sub

    Protected Log As String = ""

    Sub FlushLog()
        RaiseEvent LogAdd(Log)
        Log = ""
    End Sub

    Sub ClearLog()
        RaiseEvent LogAdd("<clr>")
    End Sub

    Private Sub Board_GotFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles Board.GotFocus
        Timer.Start()
    End Sub

    Private Sub Board_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles Board.LostFocus
        Timer.Stop()
        CursorOn = False
        Invalidate(CellRect(Cursor.X, Cursor.Y))
    End Sub

    <DebuggerHidden()> _
    Sub Break()
        Invalidate()
        Application.DoEvents()
        Stop
    End Sub


    Dim Highlighting As Boolean
    Dim LeftButtonDown As Boolean

    Private Sub Board_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Board.MouseDown
        If e.Button = MouseButtons.None Then Exit Sub
        If e.Button = MouseButtons.Right And LeftButtonDown Then
            If Selection.Count > 0 Then Edit("make group")
            Exit Sub
        End If
        If e.Button = MouseButtons.Left Then
            LeftButtonDown = True
            Dim Cell = Cells.Where(Function(c) c.Rect.Contains(e.Location)).FirstOrDefault
            If Control.ModifierKeys = Keys.Control Then
                If Cell Is Nothing Then Exit Sub
                Selection.Invert(Cell)
                Highlighting = Selection.Count > 0
            Else
                If Selection.Count > 0 Then
                    Selection.Clear()
                    Highlighting = False
                    Invalidate()
                End If
                If Cell Is Nothing Then Exit Sub
            End If
            Cursor = New Point(Cell.x, Cell.y)
            CursorOn = True
        End If
    End Sub

    Private Sub Board_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Board.MouseUp
        If e.Button = MouseButtons.Left Then
            LeftButtonDown = False
        End If
    End Sub

    Private Sub Board_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Board.MouseMove
        If e.Button = MouseButtons.None Then Exit Sub
        Dim Cell = Cells.Where(Function(c) c.Rect.Contains(e.Location)).FirstOrDefault
        If Cell Is Nothing Then Exit Sub
        Dim NewCell = New Point(Cell.x, Cell.y)
        If NewCell = Cursor Then Exit Sub
        If Not Highlighting Then
            Highlighting = True
            Selection.Add(CursorCell)
        End If
        Cursor = NewCell
        If Highlighting Then
            Selection.Add(CursorCell)
        End If
        CursorOn = True
    End Sub

    Public Gfx As Graphics

    Private Sub BoardPaint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Board.Paint
        Gfx = e.Graphics
        Dim R As New Rectangle(0, 0, sender.width, 32)
        Gfx.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
        Gfx.FillRectangle(New SolidBrush(Color.FromArgb(63, Color.Black)), R)
        R.Inflate(-8, -5)
        Gfx.DrawString(Board.FindForm().Text, New Font("segoe ui", 10, FontStyle.Bold), Brushes.White, R)
        R.Inflate(8, 5)
        'Gfx.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
        R = New Rectangle(0, R.Bottom, sender.width, sender.height - R.Bottom)
        Normalize(R, Size + 2 + HintArea.Left + HintArea.Width, Size + 2 + HintArea.Top + HintArea.Height)
        R.Inflate(-4, -4)
        Draw()
        ShowCursor(e.Graphics)
    End Sub

    Overridable Sub Draw()
        DrawCells()
        DrawRegions()
        DrawRect(1, 1, Size, Size, 1)
    End Sub

    Dim UndoStack As New Stack(Of UndoAction)
    Dim RedoStack As New Stack(Of UndoAction)

    Sub AddAction(ByVal Action As UndoAction)
        UndoStack.Push(Action)
        RedoStack.Clear()
        ArrangeButtons()
    End Sub

    Sub ArrangeButtons()
        FrmMain.MnuUndo.Enabled = UndoStack.Count > 0
        FrmMain.MnuRedo.Enabled = RedoStack.Count > 0
        FrmMain.BtnUndo.Enabled = FrmMain.MnuUndo.Enabled
        FrmMain.BtnRedo.Enabled = FrmMain.MnuRedo.Enabled
    End Sub

    Sub Undo()
        Dim Action = UndoStack.Pop
        RedoStack.Push(Action)
        Cursor = New Point(Action.Cell.x, Action.Cell.y)
        Action.Cell.g(True) = Action.UndoValue
        ArrangeButtons()
        If AutosolveMode Then Solve()
    End Sub

    Sub Redo()
        Dim Action = RedoStack.Pop
        UndoStack.Push(Action)
        Cursor = New Point(Action.Cell.x, Action.Cell.y)
        Action.Cell.g(True) = Action.RedoValue
        ArrangeButtons()
        If AutosolveMode Then Solve()
    End Sub

    Function Find(ByVal x As Integer, ByVal y As Integer) As Cell
        If Cells Is Nothing Then Return Nothing
        Return Cells.Where(Function(c) c.x = x And c.y = y).FirstOrDefault
    End Function

    Sub SetRegions()
        Regions.Clear()
        For Each Item In (From c In Cells Select c.Region).Distinct
            Dim Region As New Region
            Regions.Add(Region)
            Dim ch = Item
            Region.Cells = (From c In Cells Where c.Region = ch).ToList
        Next
        For Each c In Cells
            c.Region = ""
        Next
    End Sub

    Class SelectedCells
        Inherits Cells

        Shadows Function Contains(ByVal Cell As Cell) As Boolean
            Return MyBase.Contains(Cell)
        End Function

        Shadows Sub Clear()
            For Each Cell In Me
                Cell.Invalidate()
            Next
            MyBase.Clear()
        End Sub

        Sub Invert(ByVal Cell As Cell)
            If Contains(Cell) Then Remove(Cell) Else Add(Cell)
        End Sub

        Shadows Sub Add(ByVal Cell As Cell)
            If Contains(Cell) Then Exit Sub
            MyBase.Add(Cell)
            Cell.Invalidate()
        End Sub

        Shadows Sub Remove(ByVal Cell As Cell)
            If Not Contains(Cell) Then Exit Sub
            MyBase.Remove(Cell)
            Cell.Invalidate()
        End Sub

    End Class

End Class

Public Enum PuzzleMode
    Author
    Player
End Enum

Public Class DrawCellArgs
    Public Cell As Cell
    Public Invert As Boolean
    Public Circled As Boolean
    Public Text As String
End Class

Public Class Cells
    Inherits HashSet(Of Cell)


    Sub New()

    End Sub

    Sub New(ByVal Cells As IEnumerable(Of Cell))
        Clear()
        AddRange(Cells)
    End Sub

    Sub AddRange(ByVal Cells As IEnumerable(Of Cell))
        For Each Item In Cells
            Add(Item)
        Next
    End Sub

    ReadOnly Property Givens(Optional ByVal ch As String = "") As IEnumerable(Of Cell)
        Get
            Return Where(Function(c) Trim(c.g) > ch)
        End Get
    End Property

    ReadOnly Property Founds As IEnumerable(Of Cell)
        Get
            Return Where(Function(c) Trim(c.f) > "")
        End Get
    End Property

    ReadOnly Property Empties As IEnumerable(Of Cell)
        Get
            Return Where(Function(c) Trim(c.g) = "" AndAlso c.f = "")
        End Get
    End Property

End Class

Public Class Groups
    Inherits HashSet(Of Group)

    Sub New()

    End Sub

    Sub New(ByVal Groups As IEnumerable(Of Group))
        Clear()
        AddRange(Groups)
    End Sub

    Sub AddRange(ByVal Groups As IEnumerable(Of Group))
        For Each Item In Groups
            Add(Item)
        Next
    End Sub

End Class

Public Class UndoAction

    Public Cell As Cell
    Public UndoValue As String
    Public RedoValue As String

    Sub New(ByVal Cell As Cell, ByVal Undo As String, ByVal Redo As String)
        Me.Cell = Cell
        Me.UndoValue = Undo
        Me.RedoValue = Redo
    End Sub

End Class